home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / arvis1 / scroll.ctl < prev    next >
Text File  |  1997-08-10  |  6KB  |  162 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ArviScroll 
  3.    ClientHeight    =   3600
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   4800
  7.    BeginProperty Font 
  8.       Name            =   "Terminal"
  9.       Size            =   13.5
  10.       Charset         =   255
  11.       Weight          =   700
  12.       Underline       =   0   'False
  13.       Italic          =   0   'False
  14.       Strikethrough   =   0   'False
  15.    EndProperty
  16.    ScaleHeight     =   3600
  17.    ScaleWidth      =   4800
  18.    Begin VB.Label Label1 
  19.       Caption         =   "Label1"
  20.       Height          =   600
  21.       Left            =   675
  22.       TabIndex        =   0
  23.       Top             =   1125
  24.       Width           =   1725
  25.       WordWrap        =   -1  'True
  26.    End
  27. End
  28. Attribute VB_Name = "ArviScroll"
  29. Attribute VB_GlobalNameSpace = False
  30. Attribute VB_Creatable = True
  31. Attribute VB_PredeclaredId = False
  32. Attribute VB_Exposed = False
  33. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  34. ' This Control Scrolls Text Across It '
  35. '_____________________________________'
  36. Dim ExitIt As Boolean
  37. Dim Scrolling As Boolean
  38. Dim sStr As String ' start string
  39. ' Calling This Start the Scroll
  40. Public Sub StartScroll(Optional Speed As Single = 2.5)
  41.  If Scrolling = True Then Exit Sub
  42.  ExitIt = False
  43.  sStr = Label1.caption
  44.  Dim tStr As String    ' temporary string
  45.  Dim NoLets As Integer ' number of letters
  46.  Dim oStr As String    ' original string
  47.  Dim i
  48.  On Error Resume Next
  49.  Do
  50.  Scrolling = True
  51.   For i = 0 To Speed * 1000
  52.    DoEvents
  53.    If ExitIt = True Then GoTo nd:
  54.   Next i
  55.   oStr = Label1.caption           '-----------
  56.   NoLets = Len(Label1.caption)    '
  57.   tStr = Left$(oStr, 1)            '  Get The Fisrt Letter
  58.   oStr = Right$(oStr, (NoLets - 1)) ' And move it to the end.
  59.   Label1 = oStr + tStr             '----------
  60.   DoEvents
  61.  Loop Until ExitIt = True
  62. nd:
  63. Scrolling = False
  64. Label1 = sStr
  65. Exit Sub
  66. End Sub
  67. Public Sub ExitScroll()
  68.  ExitIt = True
  69.  Scrolling = False
  70.  Label1 = sStr
  71. End Sub
  72. Private Sub UserControl_Initialize()
  73.  ExitIt = False
  74. End Sub
  75. Private Sub UserControl_Resize()
  76.  Label1.Top = 0
  77.  Label1.Left = 0 '-100
  78.  Label1.Width = UserControl.Width '+ 200
  79.  Label1.Height = UserControl.Height
  80. End Sub
  81.  
  82. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  83. ' THE REST OF THE CODE IS USED FOR THE CONTROL'S '
  84. ' PROPERTIES, eg Text Colour, Font Size ...      '
  85. '________________________________________________'
  86. Public Property Get BackColor() As OLE_COLOR
  87. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  88.     BackColor = Label1.BackColor
  89. End Property
  90. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  91.     Label1.BackColor() = New_BackColor
  92.     PropertyChanged "BackColor"
  93. End Property
  94. Public Property Get BorderStyle() As Integer
  95. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  96.     BorderStyle = Label1.BorderStyle
  97. End Property
  98. Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  99.     Label1.BorderStyle() = New_BorderStyle
  100.     PropertyChanged "BorderStyle"
  101. End Property
  102. Public Property Get caption() As String
  103. Attribute caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
  104.     caption = Label1.caption
  105. End Property
  106. Public Property Let caption(ByVal New_caption As String)
  107.     Label1.caption() = New_caption
  108.     PropertyChanged "caption"
  109. End Property
  110. Public Property Get Font() As Font
  111. Attribute Font.VB_Description = "Returns a Font object."
  112. Attribute Font.VB_UserMemId = -512
  113.     Set Font = Label1.Font
  114. End Property
  115. Public Property Set Font(ByVal New_Font As Font)
  116.     Set Label1.Font = New_Font
  117.     PropertyChanged "Font"
  118. End Property
  119. Public Property Get ForeColor() As OLE_COLOR
  120. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  121.     ForeColor = Label1.ForeColor
  122. End Property
  123. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  124.     Label1.ForeColor() = New_ForeColor
  125.     PropertyChanged "ForeColor"
  126. End Property
  127. Public Sub Refresh()
  128. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  129.     Label1.Refresh
  130. End Sub
  131. Public Property Get Alignment() As Integer
  132. Attribute Alignment.VB_Description = "Returns/sets the alignment of a CheckBox or OptionButton, or a control's text."
  133.     Alignment = Label1.Alignment
  134. End Property
  135. Public Property Let Alignment(ByVal New_Alignment As Integer)
  136.     Label1.Alignment() = New_Alignment
  137.     PropertyChanged "Alignment"
  138. End Property
  139. 'Load property values from storage
  140. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  141.     Label1.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  142.     Label1.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  143.     Label1.caption = PropBag.ReadProperty("caption", "Label1")
  144.     Set Label1.Font = PropBag.ReadProperty("Font", Ambient.Font)
  145.     Label1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  146.     Label1.Alignment = PropBag.ReadProperty("Alignment", 0)
  147. End Sub
  148. Private Sub UserControl_Terminate()
  149.  ExitScroll
  150.  ExitIt = True
  151. End Sub
  152. 'Write property values to storage
  153. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  154.     Call PropBag.WriteProperty("BackColor", Label1.BackColor, &H8000000F)
  155.     Call PropBag.WriteProperty("BorderStyle", Label1.BorderStyle, 0)
  156.     Call PropBag.WriteProperty("caption", Label1.caption, "Label1")
  157.     Call PropBag.WriteProperty("Font", Label1.Font, Ambient.Font)
  158.     Call PropBag.WriteProperty("ForeColor", Label1.ForeColor, &H80000012)
  159.     Call PropBag.WriteProperty("Alignment", Label1.Alignment, 0)
  160. End Sub
  161.  
  162.